;;; Copyright © 2017, 2018 Kei Kebreau <kkebreau@posteo.net>
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(define-module (pascal)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (gnu packages)
  #:use-module (guix gexp)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bison)
  #:use-module (gnu packages bootstrap)
  #:use-module (gnu packages commencement)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages xml)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match))

(define %patch-dir
  (string-append (if (current-filename)
                     (dirname (current-filename))
                     ".")
                 "/patches"))

(define fpc-bootstrap-x86_64-3.0.4
  (origin
    (method url-fetch)
    (uri
     "mirror://sourceforge/freepascal/Linux/3.0.4/fpc-3.0.4.x86_64-linux.tar")
    (sha256
     (base32
      "0xzxh689iyjfmkqkhcqg9plrjmdx82hbyywyyc7jm0n92fpmp5ky"))))

(define fpc-bootstrap-i386-3.0.4
  (origin
    (method url-fetch)
    (uri
     "mirror://sourceforge/freepascal/Linux/3.0.4/fpc-3.0.4.i386-linux.tar")
    (sha256
     (base32
      "05xfgxa6vb0y2ryfsgn21m2kwaxhci6l2zxa3akvlnqminjsjvda"))))

(define fpc-bootstrap-armhf-3.0.4
  (origin
    (method url-fetch)
    (uri
     "ftp://ftp.freepascal.org/pub/fpc/dist/3.0.4/arm-linux/fpc-3.0.4.arm-linux-eabihf-raspberry.tar")
    (sha256
     (base32
      "0r8g804vhy15744mxgbsmix0vxazxynqw4fdfiyap07wyr3xyh79"))))

(define-public fpc
  (let ((arch (match (%current-system)
                ("x86_64-linux" "x86_64")
                ("i686-linux" "i386")
                ("armhf-linux" "arm")
                (_ ""))))
    (package
      (name "fpc")
      (version "3.0.4")
      (source (origin
                (method url-fetch)
                (uri (string-append "mirror://sourceforge/freepascal/Source/"
                                    version "/fpcbuild-" version ".tar.gz"))
                (file-name (string-append name "-" version ".tar.gz"))
                (sha256
                 (base32
                  "0xjyhlhz846jbnp12y68c7nq4xmp4i65akfbrjyf3r62ybk18rgn"))
                (patches
                 (list
                  (local-file
                   (string-append %patch-dir "/fpc-reproducibility.patch"))))))
      (build-system gnu-build-system)
      (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))
      (inputs
       `(("expat" ,expat)
         ("glibc" ,glibc)
         ("ld-wrapper" ,ld-wrapper)
         ("ncurses" ,ncurses)
         ("zlib" ,zlib)))
      (native-inputs
       ;; FPC is built with FPC, so we need bootstrap binaries.
       `(("fpc-binary"
          ,(cond ((string= arch "x86_64") fpc-bootstrap-x86_64-3.0.4)
                 ((string= arch "i386") fpc-bootstrap-i386-3.0.4)
                 (else fpc-bootstrap-armhf-3.0.4)))))
      (arguments
       `(#:tests? #f ; no tests available
         #:phases
         (let ((fpc-bootstrap-path
                (string-append (getcwd) "/" ,name "-"
                               ,version "/fpc-bin")))
           (modify-phases %standard-phases
             (add-after 'unpack 'unpack-bin
               (lambda* (#:key inputs #:allow-other-keys)
                 (mkdir-p fpc-bootstrap-path)
                 (with-directory-excursion fpc-bootstrap-path
                   (invoke "tar" "xvf" (assoc-ref inputs "fpc-binary")))))
             (add-after 'unpack-bin 'install-bin
               (lambda* (#:key inputs #:allow-other-keys)
                 (with-directory-excursion
                     (string-append fpc-bootstrap-path "/fpc-"
                                    ,version "." ,arch "-linux")
                   (let ((binary-tarball
                          (string-append "binary." ,arch "-linux.tar"))
                         (compiler-tarball
                          (string-append "base." ,arch "-linux.tar.gz"))
                         (fpcmake-tarball
                          (string-append "utils-fpcm." ,arch "-linux.tar.gz")))
                     (and
                      ;; Only the base compiler and fpcmake are needed.
                      (invoke "tar" "xvf" binary-tarball
                              compiler-tarball
                              fpcmake-tarball)
                      (invoke "tar" "xvf" compiler-tarball "-C..")
                      (invoke "tar" "xvf" fpcmake-tarball "-C.."))))))
             (add-after 'patch-source-shebangs 'patch-inline-shebangs
               (lambda _
                 (substitute* "fpcsrc/compiler/script.pas"
                   (("#!/bin/sh") (string-append "#!" (which "sh"))))
                 #t))
             (replace 'configure
               (lambda* (#:key inputs outputs #:allow-other-keys)
                 (substitute* "fpcsrc/compiler/systems/t_linux.pas"
                   ;; Point to the current glibc dynamic linker.
                   (("/lib/ld-linux.*.so.[0-9]")
                    (string-append (assoc-ref inputs "libc")
                                   ,(glibc-dynamic-linker)))
                   (("/lib64/ld-linux-x86-64.so.2")
                    (string-append (assoc-ref inputs "libc")
                                   ,(glibc-dynamic-linker)))
                   ;; Add glibc to ld's search path.
                   (("if \\(isdll\\) then")
                    (string-append
                     "Add('SEARCH_DIR(\""
                     (assoc-ref inputs "libc") "/lib"
                     "\")');\n"
                     "if (isdll) then")))
                 (substitute* "fpcsrc/compiler/options.pas"
                   (("exepath\\+'../etc/'")
                    (string-append "'" (assoc-ref outputs "out") "/etc'")))
                 #t))
             (replace 'build
               (lambda* (#:key inputs #:allow-other-keys)
                 (let* ((fpc-bin (string-append fpc-bootstrap-path "/bin"))
                        (fpc (string-append fpc-bin "/fpc"))
                        (fpcmake (string-append fpc-bin "/fpcmake")))
                   ;; The fpc binary needs to run the ppc[arch] binary (which
                   ;; does the actual compiling) in this directory.
                   (setenv "PATH"
                          (string-append (getenv "PATH") ":"
                                         fpc-bootstrap-path
                                         "/lib/fpc/" ,version))
                   (setenv "FPC" fpc)
                   ;; Enable the compiler to link to glibc by adding glibc
                   ;; libraries to the compiler's library path.
                   (setenv "OPT" (string-append
                                  "-Fl"
                                  (assoc-ref %build-inputs "libc") "/lib"))
                   (and
                    ;; Specify target operating system using "-T" option
                    (invoke fpcmake
                            (string-append "-T" ,arch "-linux"))
                    (invoke "make" "build" "NOGDB=1")))))
             (replace 'install
               (lambda* (#:key outputs #:allow-other-keys)
                 (let* ((out (assoc-ref outputs "out"))
                        ;; This is the suffix of the ppc[arch] binary.
                        (suffix (cond ((string= ,arch "x86_64") "x64")
                                      ((string= ,arch "i386") "386")
                                      ((string= ,arch "arm") "arm")
                                      (else "")))
                       (ppc (string-append "ppc" suffix)))
                   (invoke "make" "install" "NOGDB=1"
                           (string-append "INSTALL_PREFIX=" out))
                   ;; Add a symlink to the ppc[arch] binary so fpc works.
                   (symlink (string-append out "/lib/fpc/" ,version "/" ppc)
                            (string-append out "/bin/" ppc))
                   ;; Install the example configuration file.
                   (mkdir (string-append out "/etc"))
                   (invoke
                    (string-append out "/lib/fpc/" ,version "/samplecfg")
                    (string-append out "/lib/fpc/" ,version)
                    (string-append out "/etc")))))
             (add-after 'install 'wrap
               (lambda* (#:key inputs outputs #:allow-other-keys)
                 (let* ((out (assoc-ref outputs "out"))
                        (fpc (string-append out "/bin/fpc"))
                        (ld (assoc-ref inputs "ld-wrapper"))
                        (glibc (assoc-ref inputs "glibc")))
                   (wrap-program fpc
                     `("PATH" ":" prefix (,(string-append ld "/bin")))
                     `("LIBRARY_PATH" ":" prefix (,(string-append glibc "/lib"))))
                   #t)))))))
      ;; fpc invokes gcc, so make sure LIBRARY_PATH et.al are set.
      ;(native-search-paths (package-native-search-paths gcc))
      (home-page "http://www.freepascal.org")
      (synopsis "The Free Pascal Compiler")
      (description
       "Free Pascal is a professional Object Pascal compiler.  It supports the
Turbo Pascal 7.0, Delphi, and Mac Pascal dialects.  Free Pascal also supports
many useful extensions to the Pascal programming language.")
      ;; The majority of the software included is licensed under the GPLv2
      ;; or later.  For more licensing details, see the appropriate files in
      ;; the install/doc directory of the source distribution.
      (license license:gpl2+))))

(define* (nix-system->gnu-triplet-for-gpc
          #:optional (system (%current-system)))
  (match system
    ("x86_64-linux"   "i686-unknown-linux-gnu")
    ("i686-linux"     "i686-unknown-linux-gnu")
    ("armhf-linux"    "armv7-unknown-linux-gnueabihf")
    ("aarch64-linux"  "aarch64-unknown-linux-gnu")
    ("mips64el-linux" "mips64el-unknown-linux-gnuabi64")
    (_                (nix-system->gnu-triplet system))))

(define-public gpc
  (package
   (name "gpc")
   (version "2.1")
   (source (origin
            (method url-fetch)
            (uri (string-append "http://www.gnu-pascal.de/stable/gpc-"
                                version ".tar.gz"))
            (sha256
             (base32 "16f5q3cp19pxcsvizzap6275ladxi94izgyzbpmkg13xig15v81j"))))
   (build-system gnu-build-system)
   (arguments
    `(#:parallel-build? #f
      #:configure-flags '("--enable-languages=pascal")
      #:phases
      (modify-phases %standard-phases
        (add-after 'unpack 'unpack-gcc-core
          (lambda* (#:key inputs #:allow-other-keys)
            (invoke "tar" "xvf" (assoc-ref inputs "gcc-core"))
            (rename-file "p" "gcc-2.95.2/gcc/p")
            (chdir "gcc-2.95.2")
            #t))
        (replace 'configure
          ;; The build process fails if the configure script is passed the
          ;; option "--enable-fast-install".
          (lambda* (#:key inputs outputs (configure-flags '())
                    #:allow-other-keys)
            (let ((out (assoc-ref outputs "out")))
              (setenv "CONFIG_SHELL" (which "sh"))
              (setenv "SHELL" (which "sh"))
              (apply invoke "./configure"
                     (string-append "--prefix=" out)
                     (string-append "--build="
                                    ,(nix-system->gnu-triplet-for-gpc))
                     (string-append "--host="
                                    ,(nix-system->gnu-triplet-for-gpc))
                     configure-flags)))))))
   (native-inputs
    `(("gcc-core",
       (origin
        (method url-fetch)
        (uri (string-append
              "mirror://gnu/gcc/gcc-2.95.2/gcc-core-2.95.2.tar.gz"))
        (sha256
         (base32 "1cc7qpgq1kja2y6q3ancqcskn4705yv63qqy8cinnaizp8wqvrk5"))))))
   (home-page "http://www.gnu-pascal.de")
   (synopsis "The GNU Pascal Compiler")
   (description
    "GNU Pascal is a Pascal compiler which combines a Pascal front-end with the
proven GCC back-end for code generation and optimization.  The current release
implements Standard Pascal (ISO 7185, levels 0 and 1), a large subset of
Extended Pascal (ISO 10206, aiming for full compliance), is highly compatible
to Borland Pascal (version 7.0) with some Delphi extensions, and provides a lot
of useful GNU extensions.")
   (license license:gpl2+)))
